home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / compress / huffman.ml < prev    next >
Text File  |  1995-06-01  |  2KB  |  81 lines
  1. type table_de_codage =
  2.   { caractère: int list vect;
  3.     mutable fin: int list };;
  4.  
  5. let encode entrée sortie codage =
  6.   esbit__initialise();
  7.   try
  8.     while true do
  9.       let c = input_char entrée in
  10.       do_list (esbit__écrire_bit sortie)
  11.               codage.caractère.(int_of_char c)
  12.     done
  13.   with End_of_file ->           (* fin du fichier d'entrée *)
  14.     do_list (esbit__écrire_bit sortie) codage.fin;
  15.     esbit__finir sortie;;
  16. type arbre_de_huffman =
  17.     Lettre of char
  18.   | Fin
  19.   | Noeud of arbre_de_huffman * arbre_de_huffman;;
  20.  
  21. let décode entrée sortie arbre =
  22.   esbit__initialise();
  23.   let rec parcours = function
  24.     Fin -> ()
  25.   | Lettre c ->
  26.       output_char sortie c; parcours arbre
  27.   | Noeud(gauche, droite) ->
  28.       if esbit__lire_bit entrée = 0
  29.       then parcours gauche
  30.       else parcours droite in
  31.   parcours arbre;;
  32. let fréquences entrée =
  33.   let fr = make_vect 256 0 in
  34.   begin try
  35.     while true do
  36.       let c = int_of_char(input_char entrée) in fr.(c) <- fr.(c) + 1
  37.     done
  38.   with End_of_file -> ()
  39.   end;
  40.   fr;;
  41. let construire_arbre fréquences =
  42.   let prio = ref (fileprio__ajoute fileprio__vide 1 Fin) in
  43.   let nombre_d'arbres = ref 1 in
  44.   for c = 0 to 255 do
  45.     if fréquences.(c) > 0 then begin
  46.       prio := fileprio__ajoute !prio
  47.                 fréquences.(c) (Lettre(char_of_int c));
  48.       incr nombre_d'arbres
  49.     end
  50.   done;
  51.   for n = !nombre_d'arbres downto 2 do
  52.     let (fréq1, arbre1, prio1) = fileprio__extraire !prio in
  53.     let (fréq2, arbre2, prio2) = fileprio__extraire prio1 in
  54.     prio := fileprio__ajoute prio2
  55.               (fréq1 + fréq2) (Noeud(arbre1,arbre2))
  56.   done;
  57.   let (_, arbre, _) = fileprio__extraire !prio in
  58.   arbre;;
  59. let arbre_vers_codage arbre =
  60.   let codage = { caractère = make_vect 256 []; fin = [] } in
  61.   let rec remplir_codage préfixe = function
  62.     Lettre c ->
  63.       codage.caractère.(int_of_char c) <- rev préfixe
  64.   | Fin ->
  65.       codage.fin <- rev préfixe
  66.   | Noeud(arbre1, arbre2) ->
  67.       remplir_codage (0 :: préfixe) arbre1;
  68.       remplir_codage (1 :: préfixe) arbre2 in
  69.   remplir_codage [] arbre;
  70.   codage;;
  71. let compresse entrée sortie =
  72.   let fréq = fréquences entrée in
  73.   let arbre = construire_arbre fréq in
  74.   let codage = arbre_vers_codage arbre in
  75.   output_value sortie arbre;
  76.   seek_in entrée 0;
  77.   encode entrée sortie codage;;
  78. let décompresse entrée sortie =
  79.   let arbre = input_value entrée in
  80.   décode entrée sortie arbre;;
  81.